Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/getdis1r/frmspell.frm

Visual Basic Form | 1999-07-26 | 6KB | 200 lines

VERSION 5.00
Begin VB.Form frmSpell
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "Dictionary"
   ClientHeight    =   4776
   ClientLeft      =   36
   ClientTop       =   276
   ClientWidth     =   5520
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4776
   ScaleWidth      =   5520
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  'CenterOwner
   Begin VB.CommandButton cmdAction
      Caption         =   "Lookup"
      Height          =   432
      Index           =   3
      Left            =   4440
      TabIndex        =   6
      Top             =   3240
      Width           =   972
   End
   Begin VB.CommandButton cmdAction
      Caption         =   "Anagarm"
      Height          =   432
      Index           =   2
      Left            =   4440
      TabIndex        =   5
      Top             =   2400
      Width           =   972
   End
   Begin VB.CommandButton cmdAction
      Caption         =   "Wildcard"
      Height          =   432
      Index           =   1
      Left            =   4440
      TabIndex        =   4
      Top             =   1560
      Width           =   972
   End
   Begin VB.CommandButton cmdAction
      Caption         =   "Spelling"
      Height          =   432
      Index           =   0
      Left            =   4440
      TabIndex        =   3
      Top             =   720
      Width           =   972
   End
   Begin VB.CommandButton cmdExit
      Caption         =   "Done"
      Height          =   432
      Left            =   4440
      TabIndex        =   2
      Top             =   4080
      Width           =   972
   End
   Begin VB.ListBox lstDisplay
      Height          =   2736
      Left            =   120
      TabIndex        =   1
      Top             =   600
      Width           =   4212
   End
   Begin VB.ComboBox cboInput
      Height          =   288
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5292
   End
Attribute VB_Name = "frmSpell"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
   Option Explicit
   Const HeightLimit = 5000
   Const WidthLimit = 5640
   Dim objMsWord As Word.Application
   Dim SugList As SpellingSuggestions
   Dim sug As SpellingSuggestion
   Dim synInfo As SynonymInfo
   Dim synList As Variant
   Dim AntList As Variant
   Private Sub cmdAction_Click(Index As Integer)
       Dim strTemp As String
       Dim blnRet As Boolean
       Dim iCount As Integer

       On Error GoTo eh_Trap:
       If cboInput.List(0) <> cboInput Then
           cboInput.AddItem cboInput, 0
       End If
       Set objMsWord = New Word.Application

       objMsWord.WordBasic.FileNew 'open a doc
       objMsWord.Visible = False 'hide the doc
       lstDisplay.Clear


       Select Case Index
           Case 0
         blnRet = objMsWord.CheckSpelling(cboInput)
           If blnRet = True Then
               lstDisplay.AddItem "OK"
           Else
               Set SugList = objMsWord.GetSpellingSuggestions(cboInput, _
               SuggestionMode:=wdSpelling)

               If SugList.Count = 0 Then
                   lstDisplay.AddItem "No suggestions"
               Else
                   For Each sug In SugList
                       lstDisplay.AddItem sug.Name
                   Next sug
               End If

           End If
           Case 1
           Set SugList = objMsWord.Application.GetSpellingSuggestions(cboInput, _
           SuggestionMode:=wdWildcard)
           If SugList.Count = 0 Then
               lstDisplay.AddItem "No suggestions"
           Else
               For Each sug In SugList
                   lstDisplay.AddItem sug.Name
               Next sug

           End If
           Case 2
        Set SugList = objMsWord.GetSpellingSuggestions(cboInput, _
           SuggestionMode:=wdAnagram)
           If SugList.Count = 0 Then
               lstDisplay.AddItem "No suggestions"
           Else
               For Each sug In SugList
                   lstDisplay.AddItem sug.Name
               Next sug
           End If
           Case 3
                   Set synInfo = objMsWord.SynonymInfo(cboInput)
           lstDisplay.AddItem "*** MEANING ***"

           If synInfo.MeaningCount >= 2 Then
               synList = synInfo.MeaningList
               For iCount = 1 To UBound(synList)
                   lstDisplay.AddItem synList(iCount)
               Next iCount
           Else
               lstDisplay.AddItem "None"
           End If
           lstDisplay.AddItem "*** SYNONYM ***"
           If synInfo.MeaningCount >= 2 Then
               synList = synInfo.SynonymList(2)
               For iCount = 1 To UBound(synList)
                   lstDisplay.AddItem synList(iCount)
               Next iCount
           Else
               lstDisplay.AddItem "None"
           End If
           Set synInfo = Nothing
       End Select
eh_exit:
   objMsWord.Quit
   Set objMsWord = Nothing
   cboInput.SetFocus
   Exit Sub
eh_Trap:
   lstDisplay.AddItem Err & vbTab & Error$
   Resume eh_exit:
   End Sub
   Private Sub cmdExit_Click()
       Unload Me
   End Sub
   Private Sub Form_Load()
       cboInput.Clear

   End Sub
   Private Sub Form_Resize()
       Select Case Me.WindowState
           Case vbNormal
           If Me.Height < HeightLimit Then
               Me.Height = HeightLimit
           End If
           lstDisplay.Height = Me.Height - 1000
           Me.Width = WidthLimit
           Case Else
       End Select
   End Sub
   Private Sub lstDisplay_DblClick()
       cboInput.AddItem lstDisplay, 0
       cboInput.ListIndex = 0
       lstDisplay.Clear
       cboInput.SetFocus

   End Sub